home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d27
/
pgmmenu.arc
/
CRC1239.CLP
< prev
next >
Wrap
Text File
|
1991-12-04
|
15KB
|
300 lines
CRC1239: PGM PARM(&SRCLIB &OBJLIB &MSGLIB &OBJOWN)
/* Program - CRC1239 */
/* CPP for command PGMSETUP */
/* Set up message file & all other objects +
required by CL-Programmer Menu. */
DCL &SRCLIB *CHAR 10 /* Source library */
DCL &OBJLIB *CHAR 10 /* Object's library */
DCL &MSGLIB *CHAR 10 /* Message file library */
DCL &OBJOWN *CHAR 10 /* Owner of object. */
DCL &LIBL *CHAR 275 /* Library list */
DCL &CMD *CHAR 512 /* RPLLIBL CMD */
DCL &MSGID *CHAR 7
DCL &MSGDTA *CHAR 132
DCL &CNT *DEC 3
MONMSG MSGID(CPF0000)
RTVJOBA USRLIBL(&LIBL) /* Save current library list */
CHGJOB LOGCLPGM(*YES) /* Log all CL commands */
CHKLIB: IF (&MSGLIB *EQ *USRLIBL) +
CHGVAR VAR(&MSGLIB) VALUE(%SST(&LIBL 01 10))
IF (&SRCLIB *EQ *USRLIBL) +
CHGVAR VAR(&SRCLIB) VALUE(%SST(&LIBL 01 10))
IF (&OBJLIB *EQ *USRLIBL) +
CHGVAR VAR(&OBJLIB) VALUE(%SST(&LIBL 01 10))
CHKLIBAUT: CHKOBJ OBJ(&MSGLIB.QSYS) OBJTYPE(*LIB)
MONMSG MSGID(CPF9800) EXEC(GOTO RCVMSG)
CHKOBJ OBJ(&SRCLIB.QSYS) OBJTYPE(*LIB)
MONMSG MSGID(CPF9800) EXEC(GOTO RCVMSG)
CHKOBJ OBJ(&OBJLIB.QSYS) OBJTYPE(*LIB)
MONMSG MSGID(CPF9800) EXEC(GOTO RCVMSG)
IF (&OBJOWN *NE *CURRENT) DO
CHKOBJ OBJ(&OBJOWN) OBJTYPE(*USRPRF)
MONMSG MSGID(CPF9800) EXEC(GOTO RCVMSG)
ENDDO
FIXLIBL: IF ((&MSGLIB *EQ QGPL) *OR (&SRCLIB *EQ QGPL) +
*OR (&OBJLIB *EQ QGPL)) +
RPLLIBL LIBL(QTEMP QRPG QIDU)
ELSE CMD(RPLLIBL LIBL(QGPL QTEMP QRPG QIDU))
ADDLIBLE (&MSGLIB) /* Set up job's library */
MONMSG MSGID(CPF2100) /* list to contain the */
ADDLIBLE (&SRCLIB) /* three specified */
MONMSG MSGID(CPF2100) /* library names. */
ADDLIBLE (&OBJLIB)
MONMSG MSGID(CPF2100)
CRTMSGF: /* Create message file and messages. */
CRTMSGF MSGF(CRCMSGF.&MSGLIB) TEXT('CRC - +
Message file for COZZI UTILITIES')
ADDMSGD MSGID(PGM0001) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTCMD CMD(&1.&2) PGM(&3) +
SRCFILE(&4.&5) PUBAUT(&6) TEXT(&7)') +
FMT((*CHAR 10) (*CHAR 10) (*CHAR 21) (*CHAR +
10) (*CHAR 10) (*CHAR 7) (*CHAR 50)) /* +
Create CRTCMD command */
ADDMSGD MSGID(PGM0002) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTCLPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) LOG(&6) ALWRTVSRC(&7) PUBAUT(&8) +
TEXT(&9)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 6) (*CHAR 4) (*CHAR +
4) (*CHAR 7) (*CHAR 50)) /* Create CRTCLP +
command */
ADDMSGD MSGID(PGM0003) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTCMNF FILE(&1.&2) SRCFILE(&3.&4) +
PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
50)) /* Create CRTCMNF command */
ADDMSGD MSGID(PGM0004) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTDFUAPP APP(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTDFUAPP command */
ADDMSGD MSGID(PGM0005) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTQRYAPP APP(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTQRYAPP command */
ADDMSGD MSGID(PGM0006) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTDSPF FILE(&1.&2) SRCFILE(&3.&4) +
RSTDSP(&5) DFRWRT(&6) PUBAUT(&7) +
TEXT(&8)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 4) (*CHAR 4) (*CHAR +
7) (*CHAR 50)) /* Create CRTDSPF command */
ADDMSGD MSGID(PGM0007) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTLF FILE(&1.&2) SRCFILE(&3.&4) +
PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
50)) /* Create CRTLF command */
ADDMSGD MSGID(PGM0008) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTMXDF FILE(&1.&2) SRCFILE(&3.&4) +
PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
50)) /* Create CRTMXDF command */
ADDMSGD MSGID(PGM0009) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTPF FILE(&1.&2) SRCFILE(&3.&4) +
SIZE(&5 &6 &7) PUBAUT(&8) TEXT(&9)') +
FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
10) (*CHAR 8) (*CHAR 5) (*CHAR 6) (*CHAR 7) +
(*CHAR 50)) /* Create CRTPF command */
ADDMSGD MSGID(PGM0010) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTPRTF FILE(&1.&2) SRCFILE(&3.&4) +
MAXRCDS(&5) SCHEDULE(&6) PUBAUT(&7) +
TEXT(&8)') FMT((*CHAR 10) (*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 6) (*CHAR 8) (*CHAR +
7) (*CHAR 50)) /* Create CRTPRTF command */
ADDMSGD MSGID(PGM0011) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTRPTPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTRPTPGM command */
ADDMSGD MSGID(PGM0012) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTRPGPGM PGM(&1.&2) SRCFILE(&3.&4) +
GENOPT(&5) USRPRF(&6) PUBAUT(&7) TEXT(&8)') +
FMT((*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
10) (*CHAR 64) (*CHAR 6) (*CHAR 7) (*CHAR +
50)) /* Create CRTRPGPGM command */
ADDMSGD MSGID(PGM0013) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTCBLPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTCBLPGM command */
ADDMSGD MSGID(PGM0014) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTPLIPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTPL1PGM command */
ADDMSGD MSGID(PGM0015) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTASMPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTASMPGM command */
ADDMSGD MSGID(PGM0016) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTBASPGM PGM(&1.&2) SRCFILE(&3.&4) +
USRPRF(&5) PUBAUT(&6) TEXT(&7)') FMT((*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 10) (*CHAR +
6) (*CHAR 7) (*CHAR 50)) /* Create +
CRTBASPGM command */
ADDMSGD MSGID(PGM0017) MSGF(CRCMSGF.&MSGLIB) +
MSG('CRTBSCF FILE(&1.&2) SRCFILE(&3.&4) +
PUBAUT(&5) TEXT(&6)') FMT((*CHAR 10) (*CHAR +
10) (*CHAR 10) (*CHAR 10) (*CHAR 7) (*CHAR +
50)) /* Create CRTBSCF command */
ADDMSGD MSGID(PGM1500) MSGF(CRCMSGF.&MSGLIB) +
MSG('Creating PGMMENU defaults data area +
for user &1.&2') SECLVL('The user profile +
&1 was specified for the display menu +
defaults command. The user currently does +
not have a defaults data area associated +
with his user profile. The defaults data +
area name &1.&2 is being created.') +
FMT((*CHAR 10) (*CHAR 10)) LOG(*YES)
ADDMSGD MSGID(PGM2011) MSGF(CRCMSGF.&MSGLIB) +
MSG('CPYSRCF FROMFILE(&2.&3) TOFILE(&4) +
FROMMBR(&1)') FMT((*CHAR 10) (*CHAR 10) +
(*CHAR 10) (*CHAR 21)) +
/* Copy source file member */
CRTOBJ: /* Create DSPMNUDFT/PGMMENU related objects. */
/* Files */
CRC1239F: CRTPF FILE(CRC1239.&OBJLIB) +
SRCFILE(QDDSSRC.&SRCLIB) SIZE(1 0 0)
CRC1235F: CRTDSPF FILE(CRC1235.&OBJLIB) +
SRCFILE(QDDSSRC.&SRCLIB) RSTDSP(*YES)
CRC1230F: CRTDSPF FILE(CRC1230.&OBJLIB) +
SRCFILE(QDDSSRC.&SRCLIB) RSTDSP(*YES) +
DFRWRT(*NO)
/* Data Areas */
PGMMENUDA: CRTDTAARA DTAARA(PGMMENU.QGPL) TYPE(*CHAR) LEN(2000) +
PUBAUT(*NORMAL) TEXT('CL-Programmer Menu: +
system-wide defaults data area')
/* Programs */
CRC1235P: CRTRPGPGM PGM(CRC1235.&OBJLIB) SRCFILE(QRPGSRC.&SRCLIB) +
GENOPT(*OPTIMIZE)
CRC1234: CRTCLPGM PGM(CRC1234.&OBJLIB) SRCFILE(QCLSRC.&SRCLIB) +
LOG(*NO) ALWRTVSRC(*NO)
CRC1233P: CRTRPGPGM PGM(CRC1233.&OBJLIB) SRCFILE(QRPGSRC.&SRCLIB) +
GENOPT(*OPTIMIZE)
CRC1230P: CRTCLPGM PGM(CRC1230.&OBJLIB) SRCFILE(QCLSRC.&SRCLIB) +
LOG(*NO) ALWRTVSRC(*NO) PUBAUT(*NONE) +
PGMMNUDFT: CRTCMD CMD(PGMMNUDFT.&OBJLIB) PGM(CRC1234.&OBJLIB) +
SRCFILE(QCMDSRC.&SRCLIB) ALLOW(*INTERACT +
*EXEC)
CRTCMD CMD(PGMMENU.&OBJLIB) PGM(CRC1230.&OBJLIB) +
SRCFILE(QCMDSRC.&SRCLIB) ALLOW(*INTERACT +
*EXEC) MAXPOS(6) PUBAUT(*NONE)
CHGPGM PGM(CRC1230.&OBJLIB) OPTIMIZE(*YES)
/* Grant same authority as QPGMMENU.QSYS */
GRTOBJAUT OBJ(CRC1230.&OBJLIB) OBJTYPE(*PGM) +
REFOBJ(QPGMMENU.QSYS)
/* Grant same authority as QPGMMENU.QSYS */
GRTOBJAUT OBJ(PGMMENU.&OBJLIB) OBJTYPE(*CMD) +
REFOBJ(QPGMMENU.QSYS) REFOBJTYPE(*PGM)
/* Change owner */
IF (&OBJOWN *NE *CURRENT) DO
/* Files */
CHGOBJOWN OBJ(CRC1230.&OBJLIB) OBJTYPE(*FILE) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRC1235.&OBJLIB) OBJTYPE(*FILE) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRC1239.&OBJLIB) OBJTYPE(*FILE) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRCMSGF.&OBJLIB) OBJTYPE(*MSGF) +
NEWOWN(&OBJOWN)
/* Commands */
CHGOBJOWN OBJ(PGMMENU.&OBJLIB) OBJTYPE(*CMD) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(PGMMNUDFT.&OBJLIB) OBJTYPE(*CMD) +
NEWOWN(&OBJOWN)
/* Programs */
CHGOBJOWN OBJ(CRC1230.&OBJLIB) OBJTYPE(*PGM) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRC1233.&OBJLIB) OBJTYPE(*PGM) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRC1234.&OBJLIB) OBJTYPE(*PGM) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(CRC1235.&OBJLIB) OBJTYPE(*PGM) +
NEWOWN(&OBJOWN)
CHGOBJOWN OBJ(PGMMENU.QGPL) OBJTYPE(*DTAARA) +
NEWOWN(&OBJOWN)
ENDDO
RSTLIBL: /* Restore current job's library list. */
CHGVAR VAR(&CMD) VALUE('RPLLIBL LIBL(' *CAT &LIBL +
*BCAT ')')
CALL PGM(QCAEXEC) PARM(&CMD 512)
RCVMSG: /* Receive and forward program messages. */
RCVMSG RMV(*YES) MSGDTA(&MSGDTA) MSGID(&MSGID)
IF (&MSGID *EQ ' ') RETURN
IF (%SST(&MSGID 1 2) *EQ 'CP' +
*OR %SST(&MSGID 1 3) *EQ 'MCH') DO
IF (&MSGDTA *EQ ' ') SNDPGMMSG MSGID(&MSGID) +
MSGF(QCPFMSG) TOPGMQ(*PRV) MSGTYPE(*DIAG)
ELSE SNDPGMMSG MSGID(&MSGID) MSGF(QCPFMSG) +
MSGDTA(&MSGDTA) TOPGMQ(*PRV) MSGTYPE(*DIAG)
CHGVAR VAR(&CNT) VALUE(&CNT + 1)
ENDDO
IF (&CNT *LT 10) GOTO RCVMSG